home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / kcl.lha / c / mapfun.c < prev    next >
C/C++ Source or Header  |  1987-06-04  |  5KB  |  305 lines
  1. /*
  2. (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. Copying of this file is authorized to users who have executed the true and
  4. proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  5. */
  6.  
  7. /*
  8.  
  9.     mapfun.c
  10.  
  11.     Mapping
  12. */
  13.  
  14. #include "include.h"
  15.  
  16. /*
  17.  
  18. Use of VS in mapfunctions:
  19.  
  20.         |    |
  21.         |-------|
  22.     base ->    |  fun    |
  23.         | list1    |
  24.         |   :    |
  25.         |   :    |
  26.         | listn    |
  27.     top ->    | value    | -----    the list which should be returned
  28.         | arg1    | --|
  29.         |   :    |   |--    arguments to FUN.
  30.         |   :    |   |    On call to FUN, vs_base = top+1
  31.         | argn    | --|            vs_top  = top+n+1
  32.         |-------|
  33.         |    |
  34.            VS
  35. */
  36.  
  37. Lmapcar()
  38. {
  39.     object *top = vs_top;
  40.     object *base = vs_base;
  41.     object x, handy;
  42.     int n = vs_top-vs_base-1;
  43.     int i;
  44.  
  45.     if (n <= 0)
  46.         too_few_arguments();
  47.     vs_push(Cnil);
  48.     for (i = 1;  i <= n;  i++) {
  49.         x = base[i];
  50.         if (endp(x)) {
  51.             base[0] = Cnil;
  52.             vs_top = base+1;
  53.             vs_base = base;
  54.             return;
  55.         }
  56.         vs_push(MMcar(x));
  57.         base[i] = MMcdr(x);
  58.     }
  59.     handy = top[0] = MMcons(Cnil,Cnil);
  60. LOOP:
  61.     vs_base = top+1;
  62.     super_funcall(base[0]);
  63.     MMcar(handy) = vs_base[0];
  64.     for (i = 1;  i <= n;  i++) {
  65.         x = base[i];
  66.         if (endp(x)) {
  67.             vs_base = top;
  68.             vs_top = top+1;
  69.             return;
  70.         }
  71.         top[i] = MMcar(x);
  72.         base[i] = MMcdr(x);
  73.     }
  74.     handy = MMcdr(handy) = MMcons(Cnil,Cnil);
  75.     vs_top = top+n+1;
  76.     goto LOOP;
  77. }
  78.  
  79. Lmaplist()
  80. {
  81.     object *top = vs_top;
  82.     object *base = vs_base;
  83.     object x, handy;
  84.     int n = vs_top-vs_base-1;
  85.     int i;
  86.  
  87.     if (n <= 0)
  88.         too_few_arguments();
  89.     vs_push(Cnil);
  90.     for (i = 1;  i <= n;  i++) {
  91.         x = base[i];
  92.         if (endp(x)) {
  93.             base[0] = Cnil;
  94.             vs_top = base+1;
  95.             vs_base = base;
  96.             return;
  97.         }
  98.         vs_push(x);
  99.         base[i] = MMcdr(x);
  100.     }
  101.     handy = top[0] = MMcons(Cnil,Cnil);
  102. LOOP:
  103.     vs_base = top+1;
  104.     super_funcall(base[0]);
  105.     MMcar(handy) = vs_base[0];
  106.     for (i = 1;  i <= n;  i++) {
  107.         x = base[i];
  108.         if (endp(x)) {
  109.             vs_base = top;
  110.             vs_top = top+1;
  111.             return;
  112.         }
  113.         top[i] = x;
  114.         base[i] = MMcdr(x);
  115.     }
  116.     handy = MMcdr(handy) = MMcons(Cnil,Cnil);
  117.     vs_top = top+n+1;
  118.     goto LOOP;
  119. }
  120.  
  121. Lmapc()
  122. {
  123.     object *top = vs_top;
  124.     object *base = vs_base;
  125.     object x;
  126.     int n = vs_top-vs_base-1;
  127.     int i;
  128.  
  129.     if (n <= 0)
  130.         too_few_arguments();
  131.     vs_push(base[1]);
  132.     for (i = 1;  i <= n;  i++) {
  133.         x = base[i];
  134.         if (endp(x)) {
  135.             vs_top = top+1;
  136.             vs_base = top;
  137.             return;
  138.         }
  139.         vs_push(MMcar(x));
  140.         base[i] = MMcdr(x);
  141.     }
  142. LOOP:
  143.     vs_base = top+1;
  144.     super_funcall(base[0]);
  145.     for (i = 1;  i <= n;  i++) {
  146.         x = base[i];
  147.         if (endp(x)) {
  148.             vs_base = top;
  149.             vs_top = top+1;
  150.             return;
  151.         }
  152.         top[i] = MMcar(x);
  153.         base[i] = MMcdr(x);
  154.     }
  155.     vs_top = top+n+1;
  156.     goto LOOP;
  157. }
  158.  
  159. Lmapl()
  160. {
  161.     object *top = vs_top;
  162.     object *base = vs_base;
  163.     object x;
  164.     int n = vs_top-vs_base-1;
  165.     int i;
  166.  
  167.     if (n <= 0)
  168.         too_few_arguments();
  169.     vs_push(base[1]);
  170.     for (i = 1;  i <= n;  i++) {
  171.         x = base[i];
  172.         if (endp(x)) {
  173.             vs_top = top+1;
  174.             vs_base = top;
  175.             return;
  176.         }
  177.         vs_push(x);
  178.         base[i] = MMcdr(x);
  179.     }
  180. LOOP:
  181.     vs_base = top+1;
  182.     super_funcall(base[0]);
  183.     for (i = 1;  i <= n;  i++) {
  184.         x = base[i];
  185.         if (endp(x)) {
  186.             vs_base = top;
  187.             vs_top = top+1;
  188.             return;
  189.         }
  190.         top[i] = x;
  191.         base[i] = MMcdr(x);
  192.     }
  193.     vs_top = top+n+1;
  194.     goto LOOP;
  195. }
  196.  
  197. Lmapcan()
  198. {
  199.     object *top = vs_top;
  200.     object *base = vs_base;
  201.     object x, handy;
  202.     int n = vs_top-vs_base-1;
  203.     int i;
  204.  
  205.     if (n <= 0)
  206.         too_few_arguments();
  207.     vs_push(Cnil);
  208.     for (i = 1;  i <= n;  i++) {
  209.         x = base[i];
  210.         if (endp(x)) {
  211.             base[0] = Cnil;
  212.             vs_top = base+1;
  213.             vs_base = base;
  214.             return;
  215.         }
  216.         vs_push(MMcar(x));
  217.         base[i] = MMcdr(x);
  218.     }
  219.     handy = Cnil;
  220. LOOP:
  221.     vs_base = top+1;
  222.     super_funcall(base[0]);
  223.     if (endp(handy)) handy = top[0] = vs_base[0];
  224.     else {
  225.         x = MMcdr(handy);
  226.         while(!endp(x)) {
  227.             handy = x;
  228.             x = MMcdr(x);
  229.         }
  230.         MMcdr(handy) = vs_base[0];
  231.         }
  232.     for (i = 1;  i <= n;  i++) {
  233.         x = base[i];
  234.         if (endp(x)) {
  235.             vs_base = top;
  236.             vs_top = top+1;
  237.             return;
  238.         }
  239.         top[i] = MMcar(x);
  240.         base[i] = MMcdr(x);
  241.     }
  242.     vs_top = top+n+1;
  243.     goto LOOP;
  244. }
  245.  
  246. Lmapcon()
  247. {
  248.     object *top = vs_top;
  249.     object *base = vs_base;
  250.     object x, handy;
  251.     int n = vs_top-vs_base-1;
  252.     int i;
  253.  
  254.     if (n <= 0)
  255.         too_few_arguments();
  256.     vs_push(Cnil);
  257.     for (i = 1;  i <= n;  i++) {
  258.         x = base[i];
  259.         if (endp(x)) {
  260.             base[0] = Cnil;
  261.             vs_top = base+1;
  262.             vs_base = base;
  263.             return;
  264.         }
  265.         vs_push(x);
  266.         base[i] = MMcdr(x);
  267.     }
  268.     handy = Cnil;
  269. LOOP:
  270.     vs_base = top+1;
  271.     super_funcall(base[0]);
  272.     if (endp(handy))
  273.         handy = top[0] = vs_base[0];
  274.     else {
  275.         x = MMcdr(handy);
  276.         while(!endp(x)) {
  277.             handy = x;
  278.             x = MMcdr(x);
  279.         }
  280.         MMcdr(handy) = vs_base[0];
  281.     }
  282.     for (i = 1;  i <= n;  i++) {
  283.         x = base[i];
  284.         if (endp(x)) {
  285.             vs_base = top;
  286.             vs_top = top+1;
  287.             return;
  288.         }
  289.         top[i] = x;
  290.         base[i] = MMcdr(x);
  291.     }
  292.     vs_top = top+n+1;
  293.     goto LOOP;
  294. }
  295.  
  296. init_mapfun()
  297. {
  298.     make_function("MAPCAR", Lmapcar);
  299.     make_function("MAPLIST", Lmaplist);
  300.     make_function("MAPC", Lmapc);
  301.     make_function("MAPL", Lmapl);
  302.     make_function("MAPCAN", Lmapcan);
  303.     make_function("MAPCON", Lmapcon);
  304. }
  305.